Collection of Tools & Utilities/Collection of Tools and Utilities.iso/archiver/lzhtv12.zip/LZHTV.PAS

Pascal/Delphi Source File | 1990-04-22 | 14KB | 600 lines

(*
 * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
 *
 * Do not distribute modified versions without my permission.
 * Do not remove or alter this notice or any other copyright notice.
 * If you use this in your own program you must distribute source code.
 * Do not use any of this in a commercial product.
 *
 *)

(*
 * LzhTV - text view utility/door for LHARC-format .LZH files
 *
 *)

{$I prodef.inc}
{$M 5000,0,0}  {minstack,minheap,maxheap}
{$D+}          {Global debug information}
{$L+}          {Local debug information}

program LzhTV;

Uses
   Dos, DosMem, MiniCrt, Mdosio, Tools, CInput;

const
   version = 'LzhTV:  LZH Text Viewer v1.2 of 04-22-90;  (C) 1990 S.H.Smith';


(* ----------------------------------------------------------- *)
(*
 * file layout declarations
 *
 *)

type
   lharc_header_rec = record
      header_length:       byte;                {0=end of file}
      header_check:        byte;                {checksum of remaining bytes}
      compression_type:    array[1..5] of char; {'-lh0-'=store '-lh1-'=LZHuf}
      compressed_size:     longint;
      original_size:       longint;
      file_time:           word;
      file_date:           word;
      file_attributes:     word;
      file_name_length:    byte;
      file_name:           string[65];
      crc16:               word;
   end;


(* ----------------------------------------------------------- *)
(*
 * input file variables
 *
 *)

const
   uinbufsize = 512;    {input buffer size}
var
   fileeof:       boolean;
   infd:          dos_handle;
   infn:          dos_filename;
   inbuf:         array[1..uinbufsize] of byte;
   inpos:         integer;
   incnt:         integer;

   header:        lharc_header_rec;


(* ----------------------------------------------------------- *)
(*
 * output stream variables
 *
 *)

const
   obufsize = 4096;     (* output buffer size; should be 4096 *)
   lookahead = 60;      (* lookahead buffer size *)
   THRESHOLD = 2;
   max_binary =   50;   {non-printing count before binary file trigger}
   max_linelen =  200;  {line length before binary file triggered}

   maxlines: integer = 500;
                        {maximum lines per session}

var
   outbuf:        array[0..obufsize] of byte; {for rle look-back}
   outpos:        longint;                 {absolute position in outfile}

   lson:    array[0..obufsize+1] of integer;
   rson:    array[0..obufsize+257] of integer;
   dad:     array[0..obufsize+1] of integer;

   uoutbuf:       string[max_linelen];    {disp line buffer}
   binary_count:  integer;                {non-text chars so far}


(* ----------------------------------------------------------- *)
(*
 * other working storage
 *
 *)

var
   expand_files:        boolean;
   header_present:      boolean;
   default_pattern:     string20;
   pattern:             string20;
   action:              string20;



(* ----------------------------------------------------
 *
 *    file input/output handlers
 *
 *)

procedure skip_rest;
begin
   dos_lseek(infd,header.compressed_size-incnt,seek_cur);
   fileeof := true;
   header.compressed_size := 0;
   incnt := 0;
end;

procedure skip_csize;
begin
   incnt := 0;
   skip_rest;
end;

procedure ReadByte(var x: byte);
begin
   if incnt = 0 then
   begin
      if header.compressed_size = 0 then
      begin
         fileeof := true;
         exit;
      end;

      inpos := sizeof(inbuf);
      if inpos > header.compressed_size then
         inpos := header.compressed_size;
      incnt := dos_read(infd,inbuf,inpos);

      inpos := 1;
      dec(header.compressed_size,incnt);
   end;

   x := inbuf[inpos];
   inc(inpos);
   dec(incnt);
end;


(* ------------------------------------------------------------- *)
procedure OutByte (c: integer);
   (* output each character from archive to screen *)

   procedure flushbuf;
   begin
      disp(uoutbuf);
      uoutbuf := '';
   end;

   procedure addchar;
   begin
      inc(uoutbuf[0]);
      uoutbuf[length(uoutbuf)] := chr(c);
   end;

   procedure not_text;
   begin
      newline;
      displn('This is not a text file!');
      skip_rest;
   end;

begin
   outbuf[outpos mod obufsize] := c;
   inc(outpos);

(********
if c = 13 then
else if c = 10 then begin
if nomore then skip_rest else newline;
end else write(chr(c));
exit;
********)

   case c of
   10:  begin
           if linenum < 1000 then
           begin
              flushbuf;
              newline;

              dec(maxlines);
              if (maxlines < 1) and (not dump_user) then
              begin
                  newline;
                  displn('You''ve seen enough.  Please download this file if you want to see more.');
                  dump_user := true;
              end;
           end;

           if nomore or dump_user then
              skip_rest;
        end;

   13: ;

   26: begin
          flushbuf;
          skip_rest;         {jump to nomore mode on ^z}
       end;

   8,9,32..255:
       begin
          if length(uoutbuf) >= max_linelen then
          begin
             flushbuf;
             if header.compressed_size > 10 then
                not_text;
          end;

          if linenum < 1000 then   {stop display on nomore}
             addchar;
       end;

   else
      begin
         if binary_count < max_binary then
            inc(binary_count)
         else
         if header.compressed_size > 10 then
            not_text;
      end;
   end;

end;


(* ---------------------------------------------------------- *)

{$i unlzh.inc}    {lzh expander}


(* ---------------------------------------------------------- *)
(*
 * This procedure displays the text contents of a specified archive
 * file.  The filename must be fully specified and verified.
 *
 *)

procedure viewfile;
var
   b: byte;

begin
   newline;
   {default_color;}
   binary_count := 0;
   getbuf := 0;
   getlen := 0;
   incnt := 0;
   outpos := 0;
   uoutbuf := '';
   fileeof := false;

   if header.compression_type = '-lh0-' then
      while (not fileeof) and (not dump_user) do
      begin
         ReadByte(b);
         OutByte(b);
      end
   else

   if header.compression_type = '-lh1-' then
      UnLZHuf
   else

      displn('Unknown compression method.');

   if nomore=false then
      newline;
   linenum := 1;
end;


(* ---------------------------------------------------------- *)
procedure _itoa(i: integer; var sp);
var
   s: array[1..2] of char absolute sp;
begin
   s[1] := chr( (i div 10) + ord('0'));
   s[2] := chr( (i mod 10) + ord('0'));
end;

function format_date(date: word): string8;
const
   s:       string8 = 'mm-dd-yy';
begin
   _itoa(((date shr 9) and 127)+80, s[7]);
   _itoa( (date shr 5) and 15,  s[1]);
   _itoa( (date      ) and 31,  s[4]);
   format_date := s;
end;

function format_time(time: word): string8;
const
   s:       string8 = 'hh:mm:ss';
begin
   _itoa( (time shr 11) and 31, s[1]);
   _itoa( (time shr  5) and 63, s[4]);
   _itoa( (time shl  1) and 63, s[7]);
   format_time := s;
end;


(* ---------------------------------------------------------- *)
procedure process_file_header;
var
   n:             word;
   fpos:          longint;
   filename:      dos_filename;

begin
   dos_lseek(infd,0,seek_cur);
   fpos := dos_tell;

   while (dump_user = false) do
   begin
      set_function(fun_arcview);

      dos_lseek(infd,fpos,seek_start);
      n := dos_read(infd,header.header_check,sizeof(byte));
      n := dos_read(infd,header.compression_type,sizeof(header.compression_type));
      n := dos_read(infd,header.compressed_size,sizeof(longint));
      n := dos_read(infd,header.original_size,sizeof(longint));
      n := dos_read(infd,header.file_time,sizeof(word));
      n := dos_read(infd,header.file_date,sizeof(word));
      n := dos_read(infd,header.file_attributes,sizeof(word));
      n := dos_read(infd,he